home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 18 / fpc103.zip / FWORDS.SEQ < prev    next >
Text File  |  1988-06-30  |  7KB  |  181 lines
  1. \ FLOOK.SEQ     File searching                          by Tom Zimmer
  2.  
  3. comment:
  4.  
  5.   Some powerful file manipulation words are now being loaded, these
  6. words allow printing, searching and listing the first line of
  7. sequential files.  Here is a synopsis:
  8.  
  9.         FLOOK  <string> <filespec#1> <filespec#2> ...  to end of line
  10.         INDEX  <filespec#1> <filespec#2> ...             "      "
  11.         FPRINT <filespec#1> <filespec#2> ...             "      "
  12.  
  13.   Each of the words may be followed by as many filespecs as will fit on
  14. a line.  The filespecs will be precessed left to right.  Filespecs can
  15. be "*.*", or "*.SEQ", or "ANYFILE", or any other filespec you want.  It
  16. is probably not a good idea to use these words on .EXE or .COM files
  17. though.
  18.  
  19.   Here is an example of how FLOOK might be used:
  20.  
  21.         FLOOK <string> F-PC COLOR STATUS <enter>
  22.  
  23. will search the files F-PC.SEQ, COLOR.SEQ, and STATUS.SEQ for <string>
  24.  
  25. comment;
  26.  
  27. only forth also editor also hidden definitions also
  28.  
  29. defer donfile           \ A function to do on all specified files
  30.  
  31. ' noop is donfile
  32.  
  33. variable fstime
  34.  
  35. : .file-once    ( --- )
  36.                 fstime @ 0=
  37.                 if      cr .shndl fstime on
  38.                 then    ;
  39.  
  40. variable noise
  41.  
  42. code searchsetup ( --- a1 n1 a2 n2 )
  43.                 mov bx, # slook.buf 1+          \ slook.buf count
  44.                 push bx
  45.                 mov al, slook.buf byte
  46.                 sub ah, ah
  47.                 push ax
  48.                 mov bx, # outbuf 1+             \ outbuf count
  49.                 push bx
  50.                 mov al, outbuf byte
  51.                 1push
  52.                 end-code
  53.  
  54. : searchfile    ( --- )
  55.                 IBRESET
  56.                 0.0 seek
  57.                 fstime off      noise @ if ." ." ?cr then
  58.                 8000 1
  59.                 do      lineread c@ 0= ?leave
  60.                         searchsetup search nip
  61.                         if      noise @
  62.                                 if      .file-once
  63.                                         cr i 3 .r space
  64.                                 else    cr
  65.                                 then    outbuf count 2- type
  66.                                 ?keypause
  67.                                 PRINTING @ 0= statv @ and
  68.                                 IF <.STAT> THEN
  69.                         then
  70.                 loop    fstime @ if cr then ;
  71.  
  72. : searchedit    ( --- )
  73.                 [ forth ]
  74.                 IBRESET
  75.                 0.0 seek
  76.                 ." ." ?cr
  77.                 8000 1
  78.                 do      ?keypause
  79.                         lineread c@ 0= ?leave
  80.                         searchsetup search nip
  81.                         if      i loadline !
  82.                                 savescr #out @ #line @ 2>r
  83.                                 byte|line off
  84.                                 ?readfile
  85.                                 shndl @ hclose drop
  86.                                 backingup @ renaming !
  87.                                 8 scrline !
  88.                                 reedit
  89.                                 shndl @ memfile $>handle
  90.                                 shndl @ hopen drop      \ Reopen file
  91.                                 restscr 2r> at
  92.                                 leave
  93.                         then
  94.                 loop    ;
  95.  
  96. variable withname
  97.  
  98. : .firstline    ( --- )
  99.                 IBRESET
  100.                 0.0 seek
  101.                 cr lineread count 2- 0 max withname @
  102.                 if      .shndl 20 #out @ - 0 max spaces
  103.                         60
  104.                 else    79
  105.                 then    min type
  106.                 ?keypause ;
  107.  
  108. only forth also definitions editor also hidden also
  109.  
  110. : fallof        ( func | file_specs --- )       \ Do something to all files
  111.                                                   \ matching file_specs.
  112.                 is donfile              \ Set function to be performed.
  113.                 dirinit
  114.                 dirseg 0= if span @ >in ! exit then
  115.                 begin   >in @ span @ <
  116.                 while   bl word         \ else get the file spec
  117.                         dup
  118.                         $getdir              \ and read the directory files.
  119.                         #fls 0=
  120.                         if      cr count type ."  No matching files."
  121.                         else    drop    #fls 0
  122.                                 ?do     i >fadr 1+ c@l ascii . <>
  123.                                         if      i >fadr dir>pad >r
  124.                                                 here shndl+ $>handle
  125.                                                 shndl+ >pathend
  126.                                                 dup shndl+ 1+ - r@ + shndl+ c!
  127.                                                 r> cmove
  128.                                                 shndl+  count + off
  129.                                                 shndl+  $hopen 0=
  130.                                                 if      PRINTING @ 0=
  131.                                                         statv @ and
  132.                                                         IF      <.STAT>
  133.                                                         THEN     donfile
  134.                                                 then    close   ?keypause
  135.                                         then
  136.                                 loop
  137.                         then
  138.                 repeat  cr ;
  139.  
  140. : flook         ( search_string file_specs --- ) \ Search files for string
  141.                 SAVESTATE noise on
  142.                 >in @ span @ 1- >       \ if nothing following command
  143.                 if      cr ." String to LOOK for  ->" query 0 word
  144.                 else    bl word
  145.                 then    slook.buf over c@ 1+ 32 min cmove
  146.                 >in @ span @ 1- >       \ if nothing following command
  147.                 if      cr ." File spec to search ->" query
  148.                 then    ['] searchfile fallof
  149.                 RESTORESTATE ;
  150.  
  151. : editall       ( search_string file_specs --- ) \ edit all files containing
  152.                 SAVESTATE
  153.                 >in @ span @ 1- >       \ if nothing following command
  154.                 if      cr ." String to LOOK for and EDIT ->" query 0 word
  155.                 else    bl word
  156.                 then    slook.buf over c@ 1+ 32 min cmove
  157.                 >in @ span @ 1- >       \ if nothing following command
  158.                 if      cr ." File spec to search ->" query
  159.                 then    ['] searchedit fallof
  160.                 RESTORESTATE ;
  161.  
  162. : index         ( file_spec --- )       \ Print first line of files
  163.                 SAVESTATE
  164.                 cr cr ." **** Use SPACE to pause, and ESC to stop. ****"
  165.                 cr 3 tenths withname on
  166.                 >in @ span @ 1- >       \ if nothing following command
  167.                 if      " *.seq" ">$ $>tib \ substitute "*.seq"
  168.                         withname off
  169.                 then    ['] .firstline fallof
  170.                 RESTORESTATE ;
  171.  
  172. : fprint        ( file_specs --- )      \ Print files specified.
  173.                 SAVESTATE
  174.                 >in @ span @ 1- >       \ if nothing following command
  175.                 if      cr ." File spec to print ->" query
  176.                 then    ['] listing fallof
  177.                 RESTORESTATE ;
  178.  
  179. only forth also definitions
  180.  
  181.